home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM 1995 Fall / PD-ROM F95.toast / Utilities / Text Utils / Alpha 5.81 ƒ / Tcl / SystemCode / clips.tcl < prev    next >
Encoding:
Text File  |  1994-07-07  |  1.2 KB  |  43 lines  |  [TEXT/ALFA]
  1. #=============================================================================
  2. #    Named Clipboards
  3. #=============================================================================
  4.  
  5. proc copyNamedClipboard {} {
  6.     global clipBoards
  7.     global pasteItemNum
  8.     set text [getText [getPos] [selEnd]]
  9.     if {![catch {prompt {Clip name?} [lindex $text 0]} name]} then {
  10.         set clipBoards($name) $text
  11.         enableMenuItem "NamedClipboards" "paste" on
  12.     }
  13. }
  14.  
  15. proc cutNamedClipboard {} {
  16.     global clipBoards
  17.     global pasteItemNum
  18.     set text [getSelect]
  19.     if {![catch {prompt {Clip name?} [lindex $text 0]} name]} then {
  20.         deleteText [getPos] [selEnd]
  21.         set clipBoards($name) $text
  22.         enableMenuItem "NamedClipboards" "paste" on
  23.     }
  24. }
  25.  
  26. proc pasteNamedClipboard {} {
  27.     global clipBoards
  28.     set ind [array startsearch clipBoards]
  29.     set res [array nextelement clipBoards $ind]
  30.     array donesearch clipBoards $ind
  31.     if {![catch {eval prompt {{Clip name?}} "$res" Clips [array names clipBoards]} name]} then {
  32.         if {[catch {set text $clipBoards($name)}]} then {
  33.             alertnote "No such clipboard."
  34.             return
  35.         }
  36.         if {[getSelect] == "" } then {
  37.             insertText $text
  38.         } else {
  39.             replaceText [getPos] [selEnd]  $text
  40.         }
  41.     } 
  42. }
  43.